home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / FORTRAN2.LZH / WEKDAY.FOR < prev    next >
Text File  |  1988-02-08  |  2KB  |  89 lines
  1.       SUBROUTINE WEKDAY ( TIME, DAY )
  2. C*
  3. C*                  *******************************
  4. C*                  *******************************
  5. C*                  **                           **
  6. C*                  **          WEKDAY           **
  7. C*                  **                           **
  8. C*                  *******************************
  9. C*                  *******************************
  10. C*
  11. C*     SUBPROGRAM :
  12. C*          WEEKDAY
  13. C*
  14. C*     AUTHOR :
  15. C*          ART RAGOSTA
  16. C*          MS 207-5
  17. C*          AMES RESEARCH CENTER
  18. C*          MOFFETT FIELD. CALIF   94035
  19. C*          (415)694-5578
  20. C*
  21. C*     PURPOSE :
  22. C*          TO CALCULATE THE DAY OF THE WEEK('SUNDAY', 'MONDAY'...) FROM
  23. C*
  24. C*     METHODOLOGY :
  25. C*          USE BUILT-IN SYSTEM SERVICES.
  26. C*
  27. C*     INPUT ARGUMENTS :
  28. C*          TIME  - THE DATE IN QUESTION (EG,'21-JAN-1985 12:00:00.00').
  29. C*
  30. C*     OUTPUT ARGUMENTS :
  31. C*          DAY  - THE DAY OF THE WEEK (EG, 'MONDAY' ).
  32. C*
  33. C*     INTERNAL WORK AREAS :
  34. C*          NONE
  35. C*
  36. C*     COMMON BLOCKS :
  37. C*          NONE
  38. C*
  39. C*     FILE REFERENCES :
  40. C*          NONE
  41. C*
  42. C*     DATA BASE ACCESS :
  43. C*          NONE
  44. C*
  45. C*     SUBPROGRAM REFERENCES :
  46. C*          SYS$BINTIM, LIB$DAY
  47. C*
  48. C*     ERROR PROCESSING :
  49. C*          NONE
  50. C*
  51. C*     TRANSPORTABILITY LIMITATIONS :
  52. C*          EVERYTHING
  53. C*
  54. C*     ASSUMPTIONS AND RESTRICTIONS :
  55. C*          NONE
  56. C*
  57. C*     LANGUAGE AND COMPILER :
  58. C*          DEC FORTRAN 77
  59. C*
  60. C*     VERSION AND DATE :
  61. C*          VERSION I.0     25-JAN-85
  62. C*
  63. C*     CHANGE HISTORY :
  64. C*          25-JAN-85    INITIAL VERSION
  65. C*
  66. C***********************************************************************
  67. C*
  68.       CHARACTER*23 TIME
  69.       CHARACTER*9 DAYS(0:6), DAY
  70.       DATA DAYS / 'WEDNESDAY',  'THURSDAY ',  'FRIDAY   ',  'SATURDAY ',
  71.      $            'SUNDAY   ',  'MONDAY   ',  'TUESDAY  '/
  72.       INTEGER ITIME(2)
  73. C
  74.       DAY = 'ERROR    '
  75.       I = SYS$BINTIM(TIME,ITIME)
  76.       IF (ABS(I) .GT. 1) RETURN
  77.       I = LIB$DAY(NDAYS,ITIME)
  78.       IF (ABS(I) .GT. 1) RETURN
  79. C
  80. C --- NDAYS IS THE NUMBER OF DAYS SINCE SYSTEM TIME 0.
  81. C
  82.       I = MOD(NDAYS,7)
  83.       DAY = DAYS(I)
  84.       RETURN
  85.       END
  86. C
  87. C---END WEKDAY
  88. C
  89.